Aminet 1 (Walnut Creek)/Aminet - June 1993 [Walnut Creek].iso/aminet/util/misc/hackertest.lha/Quest.rexx

OS/2 REXX Batch file | 1992-11-22 | 10KB | 441 lines

/* Question program $VER: Quest 0.2 1992-06-19  E. Lundevall */
parse arg qname
options results

scores. = ''
questions. = ''

if ~open(qf,qname,'Read') then do
    say 'Hey,' qname 'is not where it should be!'
    exit 10
    end

say 'Reading from question file...(Zzzzz...)'
scmatch = 'Scores:'
qmatch  = 'Questions:'
imatch  = 'Initial:'

keepGoing = 3

do until keepGoing = 0
    do until line = scmatch | line = qmatch | line = imatch
        line = readln(qf)
        end

        keepGoing = keepGoing - 1
        select
            when line = scmatch then do    /* Read the score section */
                call GetScores
                scresult = result
                end

            when line = qmatch then do     /* Read the questions */
                call GetQuestions
                qresult = result
                end

            when line = imatch then do     /* Read section with initial msg */
                call GetInitial
                iresult = result
                end
            end
        end
call close(qf)

if scresult || qresult || iresult ~= 'OkOkOk' then do
    say 'Sorry, the question file seems to be corrupt.'
    exit 10
    end

call WriteInitial      /* Greet the user, ask questions, show highscores */
call AskQuestions
theScore = result
call ShowScore(theScore)
theText = result
                         /* Possibly add score to highscore file */
highscores. = ''
call ReadHighScore(qname || '.scores')
call AddHighScore(theScore,theText)
call ShowHighScore(stdout)
say 'Do you want to add this score in the highscore file?'
parse upper pull ans
if left(ans,1) = 'Y' then do
    if open(sf,qname || '.scores','Write') then do
        call ShowHighScore(sf)
        call close(sf)
        end
    else do
        say 'Could not open score file...'
        end

    end


exit 0


/* Show greeting message */

WriteInitial: procedure expose initial.

call writech(stdout,'0c'x) /* Clear window */
do i = 1 to initial.0
    say initial.i
    end
say
return



/* Read greeting message from question file */

GetInitial: procedure expose initial. qf
keepGoing = 1
i = 1

do while keepGoing = 1
    line = readln(qf)

    select
        when line = '' then do /* This is added because empty line does  */
            initial.i = ''     /* not enter the otherwise part otherwise */
            i = i + 1
            end
        when left(line,2) = '//' | length(strip(line)) = 0 then
            iterate
        when left(line,4) = '::::' then
            keepGoing = 0
        otherwise do
            initial.i = line
            i = i + 1
            end
        end
    end
initial.0 = i - 1
return 'Ok'




/* Read score intervals from question file */

GetScores: procedure expose scores. qf
keepGoing = 1
i = 1

do while keepGoing = 1
    line = readln(qf)
    select
        when left(line,2) = '//' | length(strip(line)) = 0 then
            iterate
        when left(line,4) = '::::' then
            keepGoing = 0
        otherwise do
            parse var line low '-' high ':' text
            scores.i.lo = strip(low)
            scores.i.hi = strip(high)
            scores.i.txt = strip(text)
            i = i + 1
            end
        end
    end
scores.0 = i - 1
return 'Ok'




/* Read questions from question file */

GetQuestions: procedure expose questions. qf
keepGoing = 1
i = 0


do while keepGoing = 1
    line = readln(qf)
    select
        when (left(line,2) = '//' | length(strip(line)) = 0) then
            iterate

        when left(line,4) = '::::' then
            keepGoing = 0

        when index(word(line,1),':') ~= 0 then do  /* Start of question */
            parse var line num ':' qtext
            i = i + 1
            qtext = strip(qtext)
            if word(qtext,1) = '*' then do   /* check if multiple choices */
                qtext = subword(qtext,2)     /* is allowed for the answer */
                questions.num.multi = 1
                end
            else
                questions.num.multi = 0
            questions.num.txt = strip(qtext)
            answer = 0
            end

        when word(line,1) = '*' then do      /* Get choice line */
            parse var line '*' points text '=>' nextnum
            answer = answer + 1
            questions.num.answer.point = strip(points)
            questions.num.answer.txt = strip(text)
            if nextnum = '' then                  /* Skip to other question */
                nextnum = num + 1                 /* if this one is chosen  */
            questions.num.answer.next = strip(nextnum)
            questions.num.answernum = answer
            end
        end
    end
questions.0 = i
return 'Ok'



/* Ask a question */

AskQuestions: procedure expose questions.
myScore = 0
nextQuest = 1

do while nextQuest ~= -1
    mul = questions.nextQuest.multi
    call ShowQuestion(mul)

    gotAnswer = 0
    do until gotAnswer
        call writech(stdout,'Answer: ')
        parse pull answer

        select                     /* Check for special commands or answers */
            when answer = '' then
                iterate

            when  'QUIT' = upper(word(answer,1)) then do
                nextQuest = -1
                gotAnswer = 1
                end

            when 'LEFT' = upper(word(answer,1)) then do
                say 'We got' questions.0 - nextQuest 'questions left, at most.'
                end

            when 'AGAIN' = upper(word(answer,1)) then do
                call ShowQuestion(mul)
                end

            otherwise do  /* Got answer, check if valid */
                answer = Unique(answer)
                gotAnswer = CheckAnswer(1 questions.nextQuest.answernum mul answer)
                if gotAnswer = 0 then do
                    say 'Answer not valid, do it again...'
                    say
                    end
                end
            end
        end
    end

return myScore   /* Return score we got from this question */




/* Show the question text and the choices */

ShowQuestion: procedure expose questions. nextQuest
parse arg mul

say
say questions.nextQuest.txt
if mul then
  say '(Multiple choices possible)'
    say
    do i = 1 to questions.nextQuest.answernum
        say i':' questions.nextQuest.i.txt
        end
return



/* Show the users score and what "level" that means */

ShowScore: procedure expose scores.
parse arg score

res = ''
say 'You got' score 'points.'
say
call writech(stdout,'That means...')

oki = 0
do i = 1 to scores.0
    if score <= scores.i.hi & score >= scores.i.lo then do
        res = scores.i.txt
        say res
        oki = 1
        leave
        end
    end

if ~oki then
    say 'Can not find an appropriate entry for you.'

say
say 'These are the possible scores:'
do i = 1 to scores.0
    say AddSpace(scores.i.lo,6) '-' AddSpace(scores.i.hi,6) ' :' scores.i.txt
    end
say
return res




/* Check if answer is valid (in range, that is) */
CheckAnswer: procedure expose questions. nextQuest myScore
parse arg  lo hi mul answer
res = 0
score = 0

if ~mul then
    answer = word(answer,1)

do i = 1 to words(answer)        /* Check if each answer is numeric and */
    a = strip(word(answer,i))    /* in range */
    if datatype(a) = 'NUM' then do
        if a >= lo  & a <= hi then do
            score = score + questions.nextQuest.a.point
            res = res + 1
            end
        end
    end

if res = words(answer) then do   /* If all answers are valid, say it is ok */
    res = 1                      /* and add the score. Get next question   */
    myScore = myScore + score
    nextQuest = strip(questions.nextQuest.a.next)
    end
else
    res = 0
return res



/* Read high score file */

ReadHighScore: procedure expose highscores.
parse arg fil

i = 0
highscores.nscores = 0
highscores.first = -1
if open(sf,fil,'Read') then do
    call readln(sf)
    do until eof(sf)
        line = readln(sf)
        parse var line dummy thescore user '::' info
        if dummy ~= '' then do
            i = i + 1
            highscores.i.score = thescore
            highscores.i.name = strip(user)
            highscores.i.txt = strip(info)
            highscores.i.next = i + 1
            end
        end
    call close(sf)
    highscores.i.next = -1
    highscores.first = 1
    highscores.nscores = i
    end
return



/* Show the highscores */

ShowHighScore: procedure expose highscores. qname scores.
parse arg filehandle

call writeln(filehandle,'Top scores for' qname)
i = highscores.first
j = 0
do until i = -1
    call writech(filehandle,AddSpace(j,4) AddSpace(highscores.i.score,6))
    call writech(filehandle,AddSpace(highscores.i.name,30,2))
    call writeln(filehandle,'::' highscores.i.txt)
    i = highscores.i.next
    j = j + 1
    end
return



/* Add new score to the highscores */

AddHighScore: procedure expose highscores.
thescore = arg(1)
scoretxt = arg(2)

say 'What is your name?'
parse pull thename

num = highscores.nscores
highscores.nscores = highscores.nscores + 1
highscores.0.score = thescore
highscores.0.name = thename
highscores.0.txt = scoretxt
highscores.0.next = -1

prev = -1
i = highscores.first
do while i ~= -1
    if thescore > highscores.i.score then do
        highscores.0.next = i
        if prev ~= -1 then
            highscores.prev.next = 0
        leave
        end
    prev = i
    i = highscores.i.next
    end

if prev = -1 then     /* If we got the first/top score */
    highscores.first = 0
else if highscores.0.next = highscores.prev.next then
    highscores.prev.next = 0               /* if we got the lowest score */

return



/* Add some space to a text */

AddSpace: procedure
txt = arg(1)
num = arg(2)
start = arg(3)
if start = '' then
    start = 1
return overlay(txt,copies(' ',num),start)



/* Remove doublets of an answer */
Unique: procedure
parse arg answers

tmp = ''
do until answers = ''
    first = word(answers,1)
    tmp = tmp first
    answers = delword(answers,1,1)
    do i = 1 to words(answers)
        if word(answers,i) = first then do
            answers = delword(answers,i,1)
            i = i - 1
            end
        end
    end
return strip(tmp)